home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / DEV / I-Z / Xlisp_Source.cpt / xlprin.c < prev    next >
Text File  |  1980-01-01  |  3KB  |  155 lines
  1. /* xlprint - xlisp print routine */
  2.  
  3. #include "xlisp.h"
  4.  
  5. /* external variables */
  6. extern NODE *xlstack;
  7. extern char buf[];
  8.  
  9. /* xlprint - print an xlisp value */
  10. xlprint(fptr,vptr,flag)
  11.   NODE *fptr,*vptr; int flag;
  12. {
  13.     NODE *nptr,*next;
  14.  
  15.     /* print nil */
  16.     if (vptr == NIL) {
  17.     xlputstr(fptr,"nil");
  18.     return;
  19.     }
  20.  
  21.     /* check value type */
  22.     switch (ntype(vptr)) {
  23.     case SUBR:
  24.         putatm(fptr,"Subr",vptr);
  25.         break;
  26.     case FSUBR:
  27.         putatm(fptr,"FSubr",vptr);
  28.         break;
  29.     case LIST:
  30.         xlputc(fptr,'(');
  31.         for (nptr = vptr; nptr != NIL; nptr = next) {
  32.             xlprint(fptr,car(nptr),flag);
  33.         if (next = cdr(nptr))
  34.             if (consp(next))
  35.             xlputc(fptr,' ');
  36.             else {
  37.             xlputstr(fptr," . ");
  38.             xlprint(fptr,next,flag);
  39.             break;
  40.             }
  41.         }
  42.         xlputc(fptr,')');
  43.         break;
  44.     case SYM:
  45.         xlputstr(fptr,xlsymname(vptr));
  46.         break;
  47.     case INT:
  48.         putdec(fptr,vptr->n_int);
  49.         break;
  50.     case STR:
  51.         if (flag)
  52.         putstring(fptr,vptr->n_str);
  53.         else
  54.         xlputstr(fptr,vptr->n_str);
  55.         break;
  56.     case FPTR:
  57.         putatm(fptr,"File",vptr);
  58.         break;
  59.     case OBJ:
  60.         putatm(fptr,"Object",vptr);
  61.         break;
  62.     case FREE:
  63.         putatm(fptr,"Free",vptr);
  64.         break;
  65.     default:
  66.         putatm(fptr,"Foo",vptr);
  67.         break;
  68.     }
  69. }
  70.  
  71. /* xlterpri - terminate the current print line */
  72. xlterpri(fptr)
  73.   NODE *fptr;
  74. {
  75.     xlputc(fptr,'\n');
  76. }
  77.  
  78. /* xlputstr - output a string */
  79. xlputstr(fptr,str)
  80.   NODE *fptr; char *str;
  81. {
  82.     while (*str)
  83.     xlputc(fptr,*str++);
  84. }
  85.  
  86. /* putstring - output a string */
  87. LOCAL putstring(fptr,str)
  88.   NODE *fptr; char *str;
  89. {
  90.     int ch;
  91.  
  92.     /* output the initial quote */
  93.     xlputc(fptr,'"');
  94.  
  95.     /* output each character in the string */
  96.     while (ch = *str++)
  97.  
  98.     /* check for a control character */
  99.     if (ch < 040 || ch == '\\') {
  100.         xlputc(fptr,'\\');
  101.         switch (ch) {
  102.         case '\033':
  103.             xlputc(fptr,'e');
  104.             break;
  105.         case '\n':
  106.             xlputc(fptr,'n');
  107.             break;
  108.         case '\r':
  109.             xlputc(fptr,'r');
  110.             break;
  111.         case '\t':
  112.             xlputc(fptr,'t');
  113.             break;
  114.         case '\\':
  115.             xlputc(fptr,'\\');
  116.             break;
  117.         default:
  118.             putoct(fptr,ch);
  119.             break;
  120.         }
  121.     }
  122.  
  123.     /* output a normal character */
  124.     else
  125.         xlputc(fptr,ch);
  126.  
  127.     /* output the terminating quote */
  128.     xlputc(fptr,'"');
  129. }
  130.  
  131. /* putatm - output an atom */
  132. LOCAL putatm(fptr,tag,val)
  133.   NODE *fptr; char *tag; NODE *val;
  134. {
  135.     sprintf(buf,"#<%s: #",tag); xlputstr(fptr,buf);
  136.     sprintf(buf,AFMT,val); xlputstr(fptr,buf);
  137.     xlputc(fptr,'>');
  138. }
  139.  
  140. /* putdec - output a decimal number */
  141. LOCAL putdec(fptr,n)
  142.   NODE *fptr; int n;
  143. {
  144.     sprintf(buf,"%d",n);
  145.     xlputstr(fptr,buf);
  146. }
  147.  
  148. /* putoct - output an octal byte value */
  149. LOCAL putoct(fptr,n)
  150.   NODE *fptr; int n;
  151. {
  152.     sprintf(buf,"%03o",n);
  153.     xlputstr(fptr,buf);
  154. }
  155.